perm filename MN[CRE,BGB] blob sn#103907 filedate 1974-05-26 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00007 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	
 00005 00003	SAIL LIKE SUBROUTINE LINKAGE.
 00009 00004	LINK MACROS
 00012 00005	 NAMES OF NODE DATA WORDS.
 00014 00006	TYPE BIT OPERATIONS.
 00015 00007	PROPERTY-TYPE BITS.
 00017 ENDMK
⊗;


;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
	↓P←←17
	↓POP0J.:EX.↔POPJ P,             ↔DEFINE POP0J<GO POP0J.>
	↓POP1J.:EX.↔SUB P,[2(2)]↔GO@2(P)↔DEFINE POP1J<GO POP1J.>
	↓POP2J.:EX.↔SUB P,[3(3)]↔GO@3(P)↔DEFINE POP2J<GO POP2J.>
	↓POP3J.:EX.↔SUB P,[4(4)]↔GO@4(P)↔DEFINE POP3J<GO POP3J.>
	↓POP4J.:EX.↔SUB P,[5(5)]↔GO@5(P)↔DEFINE POP4J<GO POP4J.>

;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
	DEFINE ACCUMULATORS(LIST){ACPTR←←2	;DECLARE ACCUMULATORS.
	FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
	FOR @$ I←0,16<AC.$I←I↔>		;ACCUMULATOR NAMES FOR RAID.
	DEFINE DECLARE (LIST){
	FOR VARNAM⊂(LIST)<VARNAM:0↔>}


;FATAL ERROR MESSAGE.
	DEFINE FATAL(STR){PUSHJ P,FATAL.↑↔JFCL[ASCIZ|STR|]}
	DEFINE WARNING(STR){PUSHJ P,WARN.↑↔JFCL[ASCIZ|STR|]}
	DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
;SAIL LIKE SUBROUTINE LINKAGE.
	DEFINE CAT $(A,B){A$B}	;CONCATENATION.
	.PLEVEL←←0	;PDL BACK POINTER.
	.SLEVEL←←0	;DEPTH OF NESTED SUBROUTINE DECLARATIONS.

;SUBROUTINE DECLARATION MACROS  -  SUBR & ENDR.
;(Reminder: Right-arrow, "→" is FAIL's macro arg EVAL).
	DEFINE SUBR(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME↔INTERN NAME
	GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL     ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
	XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
	↓NAME:IFN(SAIL∨LISP){AOSG ENTERS↑↔JSR ENTRY.↑};}

;SUBN - NOT INTERN'ED SUBROUTINE.
	DEFINE SUBN(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME
	GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL     ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
	XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
	↑NAME:IFN(SAIL∨LISP){AOS ENTERS↑};}

;DEFINE ARGUMENT NAME MACRO.
	DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}
;SUBROUTINE TERMINATION MACRO.
	DEFINE ENDR{.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1↔LIT↔BLOCK 0↔BEND }

;SUBROUTINE CALLING MACROS  -  CALL & SETQ.
	DEFINE CALL(NAME,X1,X2,X3,X4,X5)
	{GLOBAL .SLEVEL,.PLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
	IFDIF<><X1>{PUSH P,X1↔.PLEVEL←.PLEVEL+1
	IFDIF<><X2>{PUSH P,X2↔.PLEVEL←.PLEVEL+1
	IFDIF<><X3>{PUSH P,X3↔.PLEVEL←.PLEVEL+1
	IFDIF<><X4>{PUSH P,X4↔.PLEVEL←.PLEVEL+1
	IFDIF<><X5>{PUSH P,X5↔.PLEVEL←.PLEVEL+1 }}}}}
	IFDIF<><NAME>{PUSHJ P,NAME }
	.PLEVEL←←CAT(.SBR,→.SLEVEL)↔.SLEVEL←←.SLEVEL-1}
	DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}

;STACK ACCESSING MACROS  -  PUSHP & POPP.
	DEFINE PUSHP(ARG){PUSH P,ARG↔.PLEVEL←←.PLEVEL+1}
	DEFINE POPP(ARG) {POP  P,ARG↔.PLEVEL←←.PLEVEL-1}
;LINK MACROS
	DEFINE LEFT $(NAM,WRD,Z){
	IFIDN<><Z><DEFINE NAM(A,Q)<HLRZ A,WRD(Q)>>
	IFDIF<><Z><DEFINE NAM(A,Q)<HLRE A,WRD(Q)>>
	DEFINE NAM$.(A,Q)<HRLM A,WRD(Q)>}

	DEFINE RIGHT $(NAM,WRD,Z){
	IFIDN<><Z><DEFINE NAM(A,Q)<HRRZ A,WRD(Q)>>
	IFDIF<><Z><DEFINE NAM(A,Q)<HRRE A,WRD(Q)>>
	DEFINE NAM$.(A,Q)<HRRM A,WRD(Q)>}

;DEFINE GEM LINK NAMES.

	LEFT(X1DC,-3,N)↔	RIGHT(Y1DC,-3,N)
	LEFT(X2DC,-2,N)↔	RIGHT(Y2DC,-2,N)
	LEFT(TYPE,0)
	DEFINE $TYPE(Q,E)<LDB Q,[POINT 4,(E),35]>

	LEFT(NFACE,1)↔		RIGHT(PFACE,1)
	LEFT(NED,2)↔		RIGHT(PED,2)↔	LEFT(NCNT,2,N)
	LEFT(NVT,3)↔		RIGHT(PVT,3)
	LEFT(NCW,4)↔		RIGHT(PCW,4)
	LEFT(DAD,4)↔		RIGHT(SON,4)
	LEFT(NWRLD,4)↔		RIGHT(PWRLD,4)
	LEFT(NCAMR,4)↔		RIGHT(PCAMR,4)
	LEFT(NCCW,5)↔		RIGHT(PCCW,5)
	LEFT(NTIME,5)↔		RIGHT(PTIME,5)
	LEFT(BRO,5)↔		RIGHT(SIS,5)
	LEFT(ALT,6)↔		RIGHT(ALT2,6)
	RIGHT(FRAME,6)↔		RIGHT(POTEN,6)
	LEFT(CW,7)↔		RIGHT(CCW,7)
	LEFT(SIMAG,7)↔		RIGHT(PIMAG,7)↔	LEFT(UFACE,7,N)
	LEFT(NUF,8)↔		RIGHT(PUF,8)

	DEFINE XDC(A,B) {HLLE A,1(B)}↔	DEFINE YDC(A,B) {HRLE A,1(B)}
	DEFINE XDC.(A,B){HLLM A,1(B)}↔	DEFINE YDC.(A,B){HLRM A,1(B)}
; NAMES OF NODE DATA WORDS.

	↓AA ←← ↓XWC ←← -3
	↓BB ←← ↓YWC ←← -2
	↓CC ←← ↓ZWC ←← -1

	↓QQ ←← 7
	↓KK ←← 3

	↓XPP ←← 4↔	↓YPP ←← 5↔	↓ZPP ←← 6
	↓IX←←0↔ 	↓IY←←1↔ 	↓IZ←←2
	↓JX←←3↔ 	↓JY←←4↔ 	↓JZ←←5
	↓KX←←6↔ 	↓KY←←7↔ 	↓KZ←←8

;NODE SERIAL TYPE NUMBERS.

	↓$FRAME		←←	0
	↓$EMPTY		←←	1
	↓$UNIVERSE	←←	2
	↓$SUN		←←	3

	↓$CAMERA	←←	4
	↓$WORLD		←←	5
	↓$WINDOW	←←	6
	↓$IMAGE		←←	7

	↓$TEXT		←←	10
	↓$XNODE		←←	11
	↓$YNODE		←←	12
	↓$ZNODE		←←	13

	↓$BODY 		←←	14
	↓$FACE 		←←	15
	↓$EDGE 		←←	16
	↓$VERT 		←←	17
;TYPE BIT OPERATIONS.

	DEFINE MARK(Q,BITS){
	IFE <BITS>⊗-22,{MOVEI BITS}
	IFN <BITS>⊗-22,{MOVSI<BITS>⊗-22}
	IORM(Q)}

	DEFINE MARKZ(Q,BITS){
	IFE <BITS>⊗-22,{MOVEI BITS}
	IFN <BITS>⊗-22,{MOVSI<BITS>⊗-22}
	ANDCAM (Q)}

	DEFINE TEST(Q,BITS){
	IFDIF<><Q><LAC(Q)>
	IFE <BITS>⊗-22,{TRNN BITS}
	IFN <BITS>⊗-22,{TLNN<BITS>⊗-22}}

	DEFINE TESTZ(Q,BITS){
	IFDIF<><Q><LAC(Q)>
	IFE <BITS>⊗-22,{TRNE BITS}
	IFN <BITS>⊗-22,{TLNE<BITS>⊗-22}}

;PROPERTY-TYPE BITS.
	↓BBIT ←← 1B17		;BODY BIT.
	↓FBIT ←← 1B16		;FACE BIT.
	↓EBIT ←← 1B15		;EDGE BIT.
	↓VBIT ←← 1B14		;VERTEX BIT.

	↓PZZ ←← 1B1		;POSITIVE Z CAMERA COORDINATES.
	↓NZZ ←← 1B10		;NEGATIVE Z IN VIEW.

	↓FOLDED ←← 1B11		;FOLDED EDGE.
	↓VISIBLE ←← 1B12	;ACTUALLY VISIBLE.
	↓POTENT ←← 1B13		;POTENTIALLY VISIBLE.
	↓DARKEN ←← 1B3		;NOT TO BE INTENSIFIED.
	↓NSHARP ←← 1B4		;NOT SHARP - SMOOTH EDGE.

	↓NORTH ←← 1B5		;2-D CLIPPER BITS.
	↓SOUTH ←← 1B6
	↓EAST  ←← 1B7
	↓WEST  ←← 1B8
	↓NSEW  ←← 17B8

	↓JUTBIT ←← 1B3		;JOINT UNDER T.
	↓JOTBIT ←← 1B4		;JOINT OVER T.

	↓TBIT3←←1B20		;TEMPORARY BITS.
	↓TBIT2←←1B19
	↓TBIT1←←1B18
	↓TMPBIT ←← 1B2

	↓BDLBIT ←← 1B1	;BODY OPERATION DISABLE LOCOR ACTION.
	↓BDVBIT ←← 1B3	;BODY OPERATION DISABLE VERTEX ACTION.
	↓BDPBIT ←← 1B4	;BODY OPERATION DISABLE PARTS ACTION.